home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / rascal.arc / DEBUG.INC < prev    next >
Encoding:
Text File  |  1980-01-01  |  8.0 KB  |  341 lines
  1. 'Rascal Program Debugger, version 1.00  (C) Copyright 1983 Marty Franz
  2.  
  3. PROCEDURE DEBUG.SETUP
  4.     'Set up stack of procedure names
  5.     DB.NPROCS = 10
  6.     DIM DB.LABEL$(DB.NPROCS),DB.LINE(DB.NPROCS)
  7.  
  8.     'Set up cursor and output variables
  9.     DB.STATUS.LINE = 25
  10.     DB.CUROFF = 0 : DB.CURON = 1
  11.     DB.BLINK = 5 : DB.CURCNT = DB.BLINK
  12.     DB.CURSOR$ = CHR$(&H5F)
  13.     DB.BKSP$ = CHR$(8)
  14.     DB.RET$ = CHR$(13)
  15.     DB.TLBOX$ = CHR$(&HC9) : DB.TRBOX$ = CHR$(&HBB)
  16.     DB.BLBOX$ = CHR$(&HC8) : DB.BRBOX$ = CHR$(&HBC)
  17.     DB.TOP$ = CHR$(&HCD)   : DB.SIDE$ = CHR$(&HBA)
  18.     DB.MASK$ = "\                              \"
  19.  
  20.     'String for proofing labels input as breakpoints
  21.     DB.LABCHRS$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789."
  22.  
  23.     'Establish error and key trapping (F10 stops debugger)
  24.     ON ERROR GOTO DB.BASIC.ERROR
  25.     ON KEY(10) DO DEBUG.KEYBD.STOP
  26.     KEY OFF
  27.     KEY (10) ON
  28.  
  29.     DB.LEVEL = 0                'No procedures entered yet
  30.     DB.BPOINT = 0                'No breakpoints in effect
  31.     DB.CMDSTOP = 0                'No command keyboard stops
  32.  
  33.     DO DEBUG.HELLO
  34.     DO DEBUG.PUSH.CURSOR
  35.     DO DEBUG.CLR.MSG
  36.     DO DEBUG.CMD
  37. ENDPROC
  38.  
  39. DB.BASIC.ERROR|                 'Error routine for BASIC errors
  40.     DO DEBUG.BASIC.ERROR
  41.     DO DEBUG.CMD
  42.     RESUME
  43.  
  44. PROCEDURE DEBUG.KEYBD.STOP        'Entered when F10 pressed
  45.     DB.CMDSTOP = 1
  46. ENDPROC
  47.  
  48. PROCEDURE DEBUG.HELLO            'Tell user available functions
  49.     CLS
  50.     PRINT "Rascal Program Debugger active..."
  51.     PRINT
  52.     PRINT "You can enter the debugger by:"
  53.     PRINT 
  54.     PRINT "   1. Pressing F10 during program execution,"
  55.     PRINT "   2. Setting a procedure breakpoint with the B command,"
  56.     PRINT "   3. Your program causing a BASIC error."
  57.     PRINT
  58.     PRINT "In the debugger, you can type:"
  59.     PRINT
  60.     PRINT "   X  to exit into BASIC (type CONT to go back),"
  61.     PRINT "   D  to list the Rascal procedures called,"
  62.     PRINT "   B  to set a procedure breakpoint,"
  63.     PRINT "   G  to resume your program's execution"
  64. ENDPROC
  65.  
  66. PROCEDURE DEBUG.BASIC.ERROR        'Process BASIC errors
  67.     COLOR 15,0
  68.     LOCATE DB.STATUS.LINE,1,CUROFF
  69.     PRINT USING "##### ";ERL;
  70.     DB.ERROR = ERR
  71.     IF DB.ERROR > 77
  72.         DB.ERROR = 77
  73.     ENDIF
  74.     DO DEBUG.ERROR.MSG
  75.     LOCATE ,,CURON
  76.     COLOR 7,0
  77. ENDPROC
  78.  
  79. PROCEDURE DEBUG.ERROR.MSG        'Decode BASIC error msg
  80.     RESTORE DB.ERROR.MSGS
  81.     REPEAT
  82.         READ DB.ERR.KEY,DB.ERROR.MSG$
  83.         IF DB.ERR.KEY = DB.ERROR
  84.             BREAK
  85.         ENDIF
  86.     UNTIL DB.ERR.KEY = 77
  87.     PRINT USING DB.MASK$;DB.ERROR.MSG$
  88. ENDPROC
  89.  
  90. PROCEDURE DEBUG.PROC            'Handle procedure call
  91.     DO DEBUG.PUSH.CURSOR
  92.     DB.LEVEL = DB.LEVEL + 1
  93.     DB.LABEL$(DB.LEVEL) = DEBUG.LABEL$
  94.     DB.LINE(DB.LEVEL) = DEBUG.LINE
  95.     DO DEBUG.TRACE.MSG
  96.     IF DB.BPOINT = 1 AND DB.BPLABEL$ = DEBUG.LABEL$
  97.         DB.CMDSTOP = 1
  98.     ENDIF
  99.     IF DB.CMDSTOP = 1
  100.         DO DEBUG.CLR.CMD
  101.         DO DEBUG.CMD
  102.         DB.CMDSTOP = 0
  103.     ENDIF
  104.     DO DEBUG.POP.CURSOR
  105. ENDPROC
  106.  
  107. PROCEDURE DEBUG.ENDP            'Handle procedure exit
  108.     DO DEBUG.PUSH.CURSOR
  109.     DB.LEVEL = DB.LEVEL - 1
  110.     DO DEBUG.TRACE.MSG
  111.     DO DEBUG.POP.CURSOR
  112. ENDPROC
  113.  
  114. PROCEDURE DEBUG.TRACE.MSG        'Display procedure and line
  115.     COLOR 15,0
  116.     LOCATE DB.STATUS.LINE,1,CUROFF
  117.     IF DB.LEVEL > 0
  118.         PRINT USING "##### ";DB.LINE(DB.LEVEL);
  119.         PRINT USING DB.MASK$;DB.LABEL$(DB.LEVEL);
  120.     ELSE
  121.         PRINT USING DB.MASK$;"Exit";
  122.     ENDIF
  123.     LOCATE ,,CURON
  124.     COLOR 7,0
  125. ENDPROC
  126.  
  127. PROCEDURE DEBUG.CMD                'Get and process commands
  128.     DB.DONE = 0
  129.     REPEAT
  130.         DO DEBUG.GET.CMD
  131.         DO DEBUG.DO.CMD
  132.     UNTIL DB.DONE = 1
  133.     DO DEBUG.CLR.CMD
  134. ENDPROC
  135.  
  136. PROCEDURE DEBUG.GET.CMD         'Get and proof debugger command
  137.     DO DEBUG.CLR.CMD
  138.     PRINT "debug: ";
  139.     REPEAT
  140.         DO DEBUG.GET.KEY
  141.         DB.ISKEY = INSTR("BDGX",DB.KEY$)
  142.     UNTIL DB.ISKEY > 0
  143. ENDPROC
  144.  
  145. PROCEDURE DEBUG.DO.CMD            'Call procedure for each command
  146.     IF DB.KEY$ = "G"
  147.         DB.DONE = 1
  148.     ELSE
  149.         IF DB.KEY$ = "X"
  150.             DO DEBUG.DO.STOP
  151.         ELSE
  152.             IF DB.KEY$ = "B"
  153.                 DO DEBUG.DO.BPOINT
  154.             ELSE
  155.                 IF DB.KEY$ = "D"
  156.                     DO DEBUG.DO.DUMP
  157.                 ELSE
  158.                     BEEP
  159.                 ENDIF
  160.             ENDIF
  161.         ENDIF
  162.     ENDIF
  163. ENDPROC
  164.  
  165. PROCEDURE DEBUG.DO.STOP         'Handle exit to BASIC
  166.     PRINT "exit to BASIC";
  167.     DO DEBUG.POP.CURSOR
  168.     PRINT : PRINT "Type CONT to go back to debugger..."
  169.     STOP
  170. ENDPROC
  171.  
  172. PROCEDURE DEBUG.DO.BPOINT        'Set breakpoint
  173.     DO DEBUG.CLR.CMD
  174.     PRINT "breakpoint: ";
  175.     DO DEBUG.GET.STRING
  176.     DB.BPLABEL$ = DB.INPUT$
  177.     IF LEN(DB.BPLABEL$) > 0
  178.         DB.BPOINT = 1
  179.     ELSE
  180.         DB.BPOINT = 0
  181.     ENDIF
  182. ENDPROC
  183.  
  184. PROCEDURE DEBUG.DO.DUMP         'Dump stack of procedure calls
  185.     PRINT "dump procedure stack";
  186.     LOCATE 1,38
  187.     PRINT DB.TLBOX$;
  188.     FOR DB.I = 1 TO 40 : PRINT DB.TOP$; : NEXT DB.I
  189.     PRINT DB.TRBOX$
  190.     FOR DB.I = DB.LEVEL TO 1 STEP -1
  191.         LOCATE ,38
  192.         PRINT DB.SIDE$;" ";
  193.         PRINT USING "##### ";DB.LINE(DB.I);
  194.         PRINT USING DB.MASK$;DB.LABEL$(DB.I);
  195.         PRINT " ";DB.SIDE$
  196.     NEXT DB.I
  197.     LOCATE ,38
  198.     PRINT DB.BLBOX$;
  199.     FOR DB.I = 1 TO 40 : PRINT DB.TOP$; : NEXT DB.I
  200.     PRINT DB.BRBOX$;
  201. ENDPROC
  202.  
  203. PROCEDURE DEBUG.GET.STRING        'Get label name for breakpoint
  204.     DB.INPUT$ = ""
  205.     DB.START.COL = POS(0)
  206.     REPEAT
  207.         DO DEBUG.GET.KEY
  208.         IF DB.KEY$ = DB.RET$
  209.             BREAK
  210.         ELSE
  211.             IF DB.KEY$ = DB.BKSP$
  212.                 DO DEBUG.DEL.CHAR
  213.             ELSE
  214.                 IF INSTR(DB.LABCHRS$,DB.KEY$) > 0
  215.                     DO DEBUG.INS.CHAR
  216.                 ELSE
  217.                     BEEP
  218.                 ENDIF
  219.             ENDIF
  220.         ENDIF
  221.     UNTIL 1 = 0
  222. ENDPROC
  223.  
  224. PROCEDURE DEBUG.GET.KEY         'Get uppercase key from keyboard
  225.     REPEAT
  226.         DO DEBUG.CURSOR
  227.         DB.KEY$ = INKEY$
  228.     UNTIL LEN(DB.KEY$) > 0
  229.     IF ASC(DB.KEY$) > 96 AND ASC(DB.KEY$) < 123
  230.         DB.KEY$ = CHR$(ASC(DB.KEY$) - 32)
  231.     ENDIF
  232. ENDPROC
  233.  
  234. PROCEDURE DEBUG.INS.CHAR        'Add char to end of breakpoint label
  235.     IF POS(0) < 79
  236.         PRINT DB.KEY$;
  237.         DB.INPUT$ = DB.INPUT$ + DB.KEY$
  238.     ELSE
  239.         BEEP
  240.     ENDIF
  241. ENDPROC
  242.  
  243. PROCEDURE DEBUG.DEL.CHAR        'Handle backspace key in input
  244.     DB.CUR.COL = POS(0)
  245.     IF DB.CUR.COL > DB.START.COL
  246.         DB.INPUT$ = LEFT$(DB.INPUT$,LEN(DB.INPUT$)-1)
  247.         PRINT " ";
  248.         LOCATE ,DB.CUR.COL-1
  249.     ELSE
  250.         BEEP
  251.     ENDIF
  252. ENDPROC
  253.  
  254. PROCEDURE DEBUG.CURSOR            'Simulate BASIC cursor
  255.     IF DB.CURCNT = DB.BLINK
  256.         IF DB.CURCHAR$ = DB.CURSOR$
  257.             DB.CURCHAR$ = " "
  258.         ELSE
  259.             DB.CURCHAR$ = DB.CURSOR$
  260.         ENDIF
  261.         DB.CURCNT = 0
  262.     ENDIF
  263.     PRINT DB.CURCHAR$;
  264.     DB.CURCNT = DB.CURCNT + 1
  265.     LOCATE ,POS(0)-1
  266. ENDPROC
  267.  
  268. PROCEDURE DEBUG.CLR.CMD         'Clear command area of status line
  269.     LOCATE DB.STATUS.LINE,40,CUROFF
  270.     PRINT SPACE$(40);
  271.     LOCATE DB.STATUS.LINE,40,CURON
  272. ENDPROC
  273.  
  274. PROCEDURE DEBUG.CLR.MSG         'Clear message area of status line
  275.     LOCATE DB.STATUS.LINE,1,CUROFF
  276.     PRINT SPACE$(40);
  277.     LOCATE DB.STATUS.LINE,1,CURON
  278. ENDPROC
  279.  
  280. PROCEDURE DEBUG.PUSH.CURSOR        'Save program's cursor
  281.     DB.ROW = CSRLIN : DB.COL = POS(0)
  282. ENDPROC
  283.  
  284. PROCEDURE DEBUG.POP.CURSOR        'Restore program's cursor
  285.     LOCATE DB.ROW,DB.COL
  286. ENDPROC
  287.  
  288. DB.ERROR.MSGS|                    'Table of BASIC error messages
  289.     DATA  1,"NEXT without FOR"
  290.     DATA  2,"Syntax error"
  291.     DATA  3,"RETURN without GOSUB"
  292.     DATA  4,"Out of data"
  293.     DATA  5,"Illegal function call"
  294.     DATA  6,"Overflow"
  295.     DATA  7,"Out of memory"
  296.     DATA  8,"Undefined line number"
  297.     DATA  9,"Subscript out of range"
  298.     DATA 10,"Duplicate definition"
  299.     DATA 11,"Division by zero"
  300.     DATA 12,"Illegal direct"
  301.     DATA 13,"Type mismatch"
  302.     DATA 14,"Out of string space"
  303.     DATA 15,"String too long"
  304.     DATA 16,"String formula too complex"
  305.     DATA 17,"Can't continue"
  306.     DATA 18,"Undefined user function"
  307.     DATA 19,"No RESUME"
  308.     DATA 20,"RESUME without error"
  309.     DATA 22,"Missing operand"
  310.     DATA 23,"Line buffer overflow"
  311.     DATA 24,"Device timeout"
  312.     DATA 25,"Device fault"
  313.     DATA 26,"FOR without NEXT"
  314.     DATA 27,"Out of paper"
  315.     DATA 29,"WHILE without WEND"
  316.     DATA 30,"WEND without WHILE"
  317.     DATA 50,"FIELD overflow"
  318.     DATA 51,"Internal error"
  319.     DATA 52,"Bad file number"
  320.     DATA 53,"File not found"
  321.     DATA 54,"Bad file mode"
  322.     DATA 55,"File already open"
  323.     DATA 57,"Device I/O error"
  324.     DATA 58,"File already exists"
  325.     DATA 61,"Disk full"
  326.     DATA 62,"Input past end"
  327.     DATA 63,"Bad record number"
  328.     DATA 64,"Bad file name"
  329.     DATA 66,"Direct statement in file"
  330.     DATA 67,"Too many files"
  331.     DATA 68,"Device unavailable"
  332.     DATA 69,"Communication buffer overflow"
  333.     DATA 70,"Disk Write Protect"
  334.     DATA 71,"Disk not ready"
  335.     DATA 72,"Disk media error"
  336.     DATA 73,"Advanced feature"
  337.     DATA 74,"Rename across disks"
  338.     DATA 75,"Path/file access error"
  339.     DATA 76,"Path not found"
  340.     DATA 77,"Unprintable error"
  341.